Mac Expert 1995 Winter/Mac Expert - Winter 95.iso/Les fichiers/Utilitaires divers/Images/Image 1.37 ƒ/Macros/Corpus Collosum Macros

Text File | 1991-03-28 | 4.1 KB | 200 lines | [TEXT/MSWD]

{
This is a set of macros for measuring the area of various regions in the corpus collosum in MRI scans. It assumes that the scans are 256x256, that you are using a 19" monitor, that the Clipboard buffer is set to 600K, and that you have a lot of RAM.

This is the procedure:

1) Open or activate the scan to be analyzed and type Z.
2) Draw a base line using the ruler.
3) Draw perpendicular lines by typing S or R.
4) Draw a perpendicular line at an arbitrary location by clicking
   on the base line with the ruler and typing A.
5) Outline the corpus collosum.
6) Threshold by typing B.
7) Measure the areas by clicking inside each region with the wand.
8) Revert to grayscale by typing G. (Optional)
9) Dispose of the 768x768 working window by typing D.
}

var  {Global variables}
  WindowNum:integer;
  x1,y1,x2,y2,LineWidth:integer;
  size,angle,dx,dy,pi,theta:real;
  width,height,dx,dy,i:integer;


macro 'Zoom Window [Z]';
var
  top,left,width,height:integer;
begin
  GetPicSize(width,height);
  if width>600 then begin
    PutMessage('Window has already been zoomed.');
    exit;
  end;
  KillRoi;
  WindowNum:=PicNumber;
  SetScaling('Nearest; New Window');
  ScaleAndRotate(3,3,0);
  ChangeValues(254,255,253); {Reserve 254-255(black) for graphics}
  SetForegroundColor(254);
  ApplyLUT;
  SetLineWidth(1);
end;


procedure DrawPerpendicularLine(x,y:integer);
begin
  moveto(x,height-y);
  lineto(x+size*cos(theta+angle),height-(y+size*sin(theta+angle)));
  moveto(x,height-y);
  lineto(x+size*cos(theta-angle),height-(y+size*sin(theta-angle)));
end;


procedure DrawLines(nSegments:integer);
begin
  for i:=1 to nSegments-1 do
    DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawLeftLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=1;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawRightLine;
var
  nSegments,i:integer;
begin
  nSegments:=5;
  i:=4;
  DrawPerpendicularLine(x1+round(i*dx/nSegments),y1+round(i*dy/nSegments));
end;


procedure DrawThePerpendiculars;
begin
  KillRoi;
  GetLine(x1,y1,x2,y2,LineWidth);
  if (x1<0) or ((x2-x1)<10) then begin
    PutMessage('Use the ruler to draw a base line first.');
    exit;
  end;
  size:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  angle:=90; {degrees}
  pi:=3.14159;
  GetPicSize(width,height);
  y1:=height-y1;
  y2:=height-y2;
  angle:=(angle/180)*pi;
  dx:=x1-x2;
  dy:=y1-y2;
  if dx=0 then begin
    if dy>=0 then theta:=pi/2 else theta:=3/2*pi
  end else begin
    theta:=arctan(dy/dx);
    if dx<0 then theta:=theta+pi;
  end;
  dx:=x2-x1;
  dy:=y2-y1;
  SetForegroundColor(255);
  DrawLines(2);
  DrawLines(3);
end;


Macro 'Draw Perpendicular Lines-Left[S]';
begin
  DrawThePerpendiculars;
  DrawLeftLine;
end;


Macro 'Draw Perpendicular Lines-Right[R]';
begin
  DrawThePerpendiculars;
  DrawRightLine;
end;


macro 'Draw Arbitrary Perpendicular Line [A]';
var
  xx1,yy1,xx2,yy2:integer;
  fraction:real;
begin
  if angle=0 then begin
    PutMessage('Draw the other perpendiclular lines first.');
    exit;
  end;
  if dx=0 then begin
    PutMessage('Draw base line first.');
    exit;
  end;
  GetLine(xx1,yy1,xx2,yy2,LineWidth);
  if not ((xx1>x1) and (xx1<x2)) then begin
    PutMessage('Click with ruler first.');
    exit;
  end;
  fraction:=(xx1-x1)/dx;
  DrawPerpendicularLine(x1+round(dx*fraction),y1+round(dy*fraction));
end;


macro 'Make Binary [B]';
var
  top,left,width,height:integer;
begin
  GetRoi(top,left,width,height);
  if width=0 then begin
    PutMessage('Please outline first.');
    exit;
  end;
  DrawBoundary;
  KillRoi;
  SetThreshold(255);
  MeasureArea(true);
  MeasureDensity(false);
  LabelParticles(false);
  IncludeInteriorHoles(true);
  WandAutoMeasure(true);
  ResetCounter;
  ShowResults;
end;

macro 'Make Grayscale [G]';
begin
  ResetGrayMap;
  KillRoi;
end;

macro 'Dispose of Window [D]';
var
  width,height:integer;
begin
  GetPicSize(width,height);
  if width>600
    then dispose
    else exit;
  if windowNum<>0 then SelectPic(WindowNum);
end;

macro 'Adjust Areas [Q]';
var
  i:integer;
begin
  for i:=1 to rCount do
    rArea[i]:=rArea[i]/9;
  ShowResults;
end;